unit uexcel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB,     Grids, DBGrids, ComObj,
  MaskUtils, ComCtrls,ZAbstractRODataset, ZAbstractDataset, ZDataset, ZSqlUpdate; 

type
  Tfrm_Excel = class(TForm)
    Qr_Busca: TZQuery;
    DS_Busca: TDataSource;
    AbrirArq: TOpenDialog;
    Salvar: TSaveDialog;
    Paginas: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    btnExportar: TBitBtn;
    Memo_SQL: TMemo;
    btnListar: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Grid: TStringGrid;
    btGeraGrid: TBitBtn;
    lbltituloGrid: TLabel;
    TabSheet3: TTabSheet;
    DBGrid1: TDBGrid;
    procedure btnListarClick(Sender: TObject);
    procedure btnExportarClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btGeraGridClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure setSQLCopy(Query:TZQuery);
    procedure setSQLQuery(Query:TZQuery);
    procedure setSQLs(SQL: String);
    procedure setSQLnop(SQL: String);
    procedure ExportarExcel;
    procedure ExportaQuery(Query:TZQuery);
    procedure ExportaReadOnlyQuery(Query: TZReadOnlyQuery);
    { Public declarations }
  end;

var
frm_Excel: Tfrm_Excel;

implementation
    uses UDados;


{$R *.dfm}

procedure Tfrm_Excel.btnListarClick(Sender: TObject);
begin
    Qr_Busca.Close;
    Qr_Busca.Sql.Clear;
    Qr_Busca.Sql.AddStrings(Memo_SQL.Lines);
    Qr_Busca.Open;
end;

procedure Tfrm_Excel.btnExportarClick(Sender: TObject);
begin
    ExportarExcel;
end;

procedure Tfrm_Excel.setSQLCopy(Query: TZQuery);
var
    i: Integer;
begin
    {Qr_Busca.Close;
    Qr_Busca.Sql.Clear;
    Qr_Busca.Sql.AddStrings(Query.Sql);
    for i := 0 to Query.ParamCount - 1 do
    begin
        Qr_Busca.Params[i].Value := Query.Params[i].Value;
    end;
    Qr_Busca.Open;}
end;

procedure Tfrm_Excel.ExportarExcel;
var linha, coluna : integer;
var planilha : variant;
var valorcampo : string;
begin
 planilha:= CreateoleObject('Excel.Application');
 planilha.WorkBooks.add(1);
 planilha.caption := 'Exportando dados do dbGrid para o Excel';
 planilha.visible := true;
 //ShowMessage(Qr_Busca.Sql[0]);
 Qr_Busca.First;
 for linha := 0 to Qr_Busca.RecordCount - 1 do
 begin
   for coluna := 1 to Qr_Busca.FieldCount do
   begin
     if Qr_Busca.Fields[coluna - 1].DataType in [ftFloat,ftCurrency,ftBCD] then
     begin
         if Qr_Busca.Fields[coluna - 1].IsNull then
             planilha.cells[linha + 2,coluna] := nil
         else
             planilha.cells[linha + 2,coluna] := Qr_Busca.Fields[coluna - 1].AsFloat;
     end else if Qr_Busca.Fields[coluna - 1].DataType in [ftTime, ftDateTime,ftDate,ftTimeStamp] then
     begin
         if (Qr_Busca.Fields[coluna - 1].IsNull) or (Qr_Busca.Fields[coluna - 1].AsString = '') then
             planilha.cells[linha + 2,coluna] := nil
         else
         begin
             try
                planilha.cells[linha + 2,coluna] := Qr_Busca.Fields[coluna - 1].AsDateTime;
             except
                planilha.cells[linha + 2,coluna] := Qr_Busca.Fields[coluna - 1].AsString;
                //ShowMessage('Erro na data '+ Qr_Busca.Fields[coluna - 1].AsString);
             end;
         end;
     end else begin
         if (pos('CPF',UpperCase(Qr_Busca.Fields[coluna-1].FieldName)) > 0) or (pos('CIC',UpperCase(Qr_Busca.Fields[coluna-1].FieldName)) > 0)
            or (pos('CGC',UpperCase(Qr_Busca.Fields[coluna-1].FieldName)) > 0)  or (pos('CNPJ',UpperCase(Qr_Busca.Fields[coluna-1].FieldName)) > 0)  then
         begin
            if Length(Qr_Busca.Fields[coluna - 1].AsString) = 11 then
            begin
                valorcampo := FormatMaskText('999.999.999-99;0;_', Qr_Busca.Fields[coluna - 1].AsString);
            end else if Length(Qr_Busca.Fields[coluna - 1].AsString) = 14 then
            begin
                valorcampo := FormatMaskText('99.999.999/9999-99;0;_', Qr_Busca.Fields[coluna - 1].AsString);
            end else
            begin
                valorcampo := Qr_Busca.Fields[coluna - 1].AsString;
            end;
         end else if (pos('CEP',UpperCase(Qr_Busca.Fields[coluna-1].FieldName)) > 0) then
         begin
            if Length(Qr_Busca.Fields[coluna - 1].AsString) = 8 then
            begin
                valorcampo := FormatMaskText('99.999-999;0;_', Qr_Busca.Fields[coluna - 1].AsString);
            end else
            begin
                valorcampo := Qr_Busca.Fields[coluna - 1].AsString;
            end;
         end else
         begin
            valorcampo := Qr_Busca.Fields[coluna - 1].AsString;
         end;
         planilha.cells[linha + 2,coluna] := valorCampo;
     end
   end;
   Qr_Busca.Next;
 end;
 for coluna := 1 to Qr_Busca.FieldCount do
 begin
   valorcampo := Qr_Busca.Fields[coluna - 1].DisplayLabel;
   planilha.cells[1,coluna] := valorcampo;
 end;
 planilha.columns.Autofit;
end;

procedure Tfrm_Excel.BitBtn1Click(Sender: TObject);
begin
    if AbrirArq.Execute then
    begin
        Memo_SQL.Lines.LoadFromFile(AbrirArq.FileName);
        btnListarClick(nil);
    end;
end;

procedure Tfrm_Excel.BitBtn2Click(Sender: TObject);
begin
    if Salvar.Execute then
    begin
        Memo_SQL.Lines.SaveToFile(AbrirArq.FileName);
    end;
end;

procedure Tfrm_Excel.setSQLs(SQL: String);
begin
    Qr_Busca.Close;
    Qr_Busca.Sql.Clear;
    Qr_Busca.Sql.Add(Sql);
    Qr_Busca.Open;

end;

procedure Tfrm_Excel.setSQLQuery(Query: TZQuery);
begin
    Qr_Busca := Query;
end;

procedure Tfrm_Excel.setSQLnop(SQL: String);
begin
    Qr_Busca.Close;
    Qr_Busca.Sql.Clear;
    Qr_Busca.Sql.Add(Sql);

end;

procedure Tfrm_Excel.ExportaQuery(Query: TZQuery);
var linha, coluna : integer;
var planilha : variant;
var valorcampo : string;
begin
 planilha:= CreateoleObject('Excel.Application');
 planilha.WorkBooks.add(1);
 planilha.caption := 'Exportando dados do dbGrid para o Excel';
 planilha.visible := true;
 //ShowMessage(Qr_Busca.Sql[0]);
 Query.First;
 for linha := 0 to Query.RecordCount - 1 do
 begin
   for coluna := 1 to Query.FieldCount do
   begin
     if Query.Fields[coluna - 1].DataType in [ftFloat,ftCurrency,ftBCD] then
     begin
         if Query.Fields[coluna - 1].IsNull then
             planilha.cells[linha + 2,coluna] := nil
         else
             planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsFloat;
     end else if Query.Fields[coluna - 1].DataType in [ftTime, ftDateTime,ftDate,ftTimeStamp] then
     begin
         if (Query.Fields[coluna - 1].IsNull) or (Query.Fields[coluna - 1].AsString = '') then
             planilha.cells[linha + 2,coluna] := nil
         else
         begin
             try
                planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsDateTime;
             except
                planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsString;
                //ShowMessage('Erro na data '+ Qr_Busca.Fields[coluna - 1].AsString);
             end;
         end;
     end else begin
         if (pos('CPF',UpperCase(Query.Fields[coluna-1].FieldName)) > 0) or (pos('CIC',UpperCase(Query.Fields[coluna-1].FieldName)) > 0) then
         begin
            if Length(Query.Fields[coluna - 1].AsString) = 11 then
            begin
                valorcampo := FormatMaskText('999.999.999-99;0;_', Query.Fields[coluna - 1].AsString);
            end else if Length(Query.Fields[coluna - 1].AsString) = 14 then
            begin
                valorcampo := FormatMaskText('99.999.999/9999-99;0;_', Query.Fields[coluna - 1].AsString);
            end else
            begin
                valorcampo := Query.Fields[coluna - 1].AsString;
            end;
         end else
         begin
            valorcampo := Query.Fields[coluna - 1].AsString;
         end;
         planilha.cells[linha + 2,coluna] := valorCampo;
     end
   end;
   Query.Next;
 end;
 for coluna := 1 to Query.FieldCount do
 begin
   valorcampo := Query.Fields[coluna - 1].DisplayLabel;
   planilha.cells[1,coluna] := valorcampo;
 end;
 planilha.columns.Autofit;

end;

procedure Tfrm_Excel.ExportaReadOnlyQuery(Query: TZReadOnlyQuery);
var linha, coluna : integer;
var planilha : variant;
var valorcampo : string;
begin
 planilha:= CreateoleObject('Excel.Application');
 planilha.WorkBooks.add(1);
 planilha.caption := 'Exportando dados do dbGrid para o Excel';
 planilha.visible := true;
 //ShowMessage(Qr_Busca.Sql[0]);
 Query.First;
 for linha := 0 to Query.RecordCount - 1 do
 begin
   for coluna := 1 to Query.FieldCount do
   begin
     if Query.Fields[coluna - 1].DataType in [ftFloat,ftCurrency,ftBCD] then
     begin
         if Query.Fields[coluna - 1].IsNull then
             planilha.cells[linha + 2,coluna] := nil
         else
             planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsFloat;
     end else if Query.Fields[coluna - 1].DataType in [ftTime, ftDateTime,ftDate,ftTimeStamp] then
     begin
         if (Query.Fields[coluna - 1].IsNull) or (Query.Fields[coluna - 1].AsString = '') then
             planilha.cells[linha + 2,coluna] := nil
         else
         begin
             try
                planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsDateTime;
             except
                planilha.cells[linha + 2,coluna] := Query.Fields[coluna - 1].AsString;
                //ShowMessage('Erro na data '+ Qr_Busca.Fields[coluna - 1].AsString);
             end;
         end;
     end else begin
         if (pos('CPF',UpperCase(Query.Fields[coluna-1].FieldName)) > 0) or (pos('CIC',UpperCase(Query.Fields[coluna-1].FieldName)) > 0) then
         begin
            if Length(Query.Fields[coluna - 1].AsString) = 11 then
            begin
                valorcampo := FormatMaskText('999.999.999-99;0;_', Query.Fields[coluna - 1].AsString);
            end else if Length(Query.Fields[coluna - 1].AsString) = 14 then
            begin
                valorcampo := FormatMaskText('99.999.999/9999-99;0;_', Query.Fields[coluna - 1].AsString);
            end else
            begin
                valorcampo := Query.Fields[coluna - 1].AsString;
            end;
         end else
         begin
            valorcampo := Query.Fields[coluna - 1].AsString;
         end;
         planilha.cells[linha + 2,coluna] := valorCampo;
     end
   end;
   Query.Next;
 end;
 for coluna := 1 to Query.FieldCount do
 begin
   valorcampo := Query.Fields[coluna - 1].DisplayLabel;
   planilha.cells[1,coluna] := valorcampo;
 end;
 planilha.columns.Autofit;

end;

procedure Tfrm_Excel.FormCreate(Sender: TObject);
begin
    Paginas.ActivePageIndex := 2;
end;

procedure Tfrm_Excel.btGeraGridClick(Sender: TObject);
var
    excel: variant;
    linha,coluna : integer;
begin

      excel := CreateOleObject('Excel.Application');
      excel.Workbooks.add(1);
      excel.Cells.Select;
      excel.Selection.NumberFormat := '@';
      excel.visible := true;

      excel.cells[1,1] := lbltituloGrid.Caption;
      for linha := 1 to Grid.RowCount  do
         for coluna := 1 to Grid.ColCount do
            begin
               excel.cells[linha+1,coluna] := Grid.cells[coluna-1,linha-1];
               excel.cells[linha+1,coluna].Select;
            end;

      excel.columns.Autofit;


end;

end.
